home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / max.arc / MAX.PAS
Encoding:
Pascal/Delphi Source File  |  1985-10-06  |  3.6 KB  |  130 lines
  1. program MAX ;
  2. {This is a program to help small children learn about
  3.  relative sizes of numbers. It uses screen control.
  4.  It was written for TURBO pascal.
  5.  Revision -   5/27/85          Mike Secord}
  6. {$I-}
  7. const
  8.   num = 12 ; {Sets the maximum number of items in each box. 14 is prog max}
  9. var
  10. i, j, k, k1, l, n, ik: integer ;
  11. flag, ok: boolean ;
  12. done, lt: string[1] ;
  13. procedure drawbox(x1,y1,x2,y2: integer) ;
  14. var
  15.   i: integer ;
  16.   begin
  17.     gotoxy(x1,y1) ;
  18.     lowvideo ;
  19.     for i := x1 to x2 do write(' ') ;
  20.     gotoxy(x1,y1+1) ;
  21.     for i := y1+1 to y2 do
  22.     begin
  23.         gotoxy(x1,i) ; write(' ') ;
  24.         gotoxy(x2,i) ; write(' ') ;
  25.     end ;
  26.     gotoxy(x1,y2) ;
  27.     for i := x1 to x2 do write(' ') ;
  28.   end; {of procedure drawbox}
  29.  
  30. procedure face (x1,y1: integer; happy: boolean) ;
  31. {x1 and y1 are the upper left hand corner of the box containing the face}
  32. var
  33.   i : integer ;
  34.   begin
  35.     gotoxy(x1,y1) ;    writeln('    *****    ') ;
  36.     gotoxy(x1,y1+1) ;  writeln(' *  o   o  * ') ;
  37.     gotoxy(x1,y1+2) ;  writeln('*     ^     *') ;
  38.     gotoxy(x1,y1+3) ;
  39.     if happy = true then writeln(' *  |___|  * ') ;
  40.     if happy = false then writeln(' *  .---.  * ') ;
  41.     gotoxy(x1,y1+4) ;  writeln('    *****    ') ;
  42.   end;{of face procedure}
  43.  
  44. begin  {main program}
  45. clrscr ;
  46. gotoxy(20,12) ;
  47. write('C O M P A R E    T H E    I T E M S    G A M E    ') ;
  48. delay(2000) ;
  49. repeat
  50.   clrscr ;
  51.   flag := true ;
  52.   highvideo ;
  53.   for j := 1 to 5 do
  54.     begin
  55.       randomize ;
  56.       ik := random(num-4)+1 ;
  57.       {DRAW LEFT HAND BOX AND ITEMS}
  58.       drawbox(3, 4, 38, 12 ) ;
  59.       highvideo ;
  60.       gotoxy(20,4) ;
  61.       write(' A ') ;
  62.       gotoxy(4,7) ;
  63.       write('                                 ') ;
  64.       gotoxy(4,9) ;
  65.       write('                                 ') ;
  66.       randomize ;
  67.       for i:= 1 to random(5)+ik  do
  68.         begin
  69.           if i > 6  then
  70.           begin
  71.              gotoxy(3+5*(i-6),9) ;
  72.              write('##') ;
  73.           end ;
  74.           if i< 7 then
  75.           begin
  76.             gotoxy(3+5*i, 7) ;
  77.             write('##') ;
  78.           end ;
  79.         end ;
  80.       {DRAW RIGHT HAND BOX AND ITEMS}
  81.       drawbox(43, 4, 78, 12 ) ;
  82.       highvideo ;
  83.       gotoxy(60,4) ;
  84.       write(' B ') ;
  85.       gotoxy(44,7) ;
  86.       write('                                 ') ;
  87.       gotoxy(44,9) ;
  88.       write('                                 ') ;
  89.       randomize ;
  90.       repeat
  91.           k1 := random(5) +ik ;
  92.       until not(k1 = i) ;
  93.       for k:= 1 to k1 do
  94.         begin
  95.           if k > 6  then
  96.           begin
  97.              gotoxy(43+5*(k-6),9) ;
  98.              write('##') ;
  99.           end ;
  100.           if k< 7 then
  101.           begin
  102.             gotoxy(43+5*k, 7) ;
  103.             write('##') ;
  104.           end ;
  105.         end ;
  106.       repeat
  107.          gotoxy(25,15) ;
  108.          write('WHICH BOX HAS THE MOST (A or B)?        ',^H,^H,^H,^H,^H,^H);
  109.          read(lt) ;
  110.          ok := (ioresult = 0) ;
  111.          if not ok then write(^G) ;
  112.       until ok ;
  113.       lt := chr(ord(lt) or 32) ; {make all upper case lower case for compare}
  114.       if ((lt='a') and (i>k))  or ((lt='b') and (k>i) )  then flag:=true
  115.       else flag := false ;
  116.       lowvideo ;
  117.       if j = 1 then face(1,19,flag)
  118.       else face((j-1)*15, 19, flag) ;
  119.     end;
  120.     highvideo ;
  121.     repeat
  122.        writeln ;
  123.        write('WOULD YOU LIKE TO PLAY AGAIN (Y or N) ? ') ;
  124.        readln(done) ;
  125.        ok := (ioresult = 0) ;
  126.        if not ok then write(^G) ;
  127.     until ok ;
  128.   until (done = 'n') or (done = 'N') ;
  129. end.
  130.